VERSION 5.00
Begin VB.Form frmcolor 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Color"
   ClientHeight    =   4620
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   6030
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   Icon            =   "frmcolor.frx":0000
   LinkTopic       =   "formcolor"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4620
   ScaleWidth      =   6030
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.TextBox colortext 
      Height          =   285
      Left            =   4680
      TabIndex        =   3
      Text            =   "0"
      Top             =   1080
      Width           =   1215
   End
   Begin VB.PictureBox piccolor 
      BorderStyle     =   0  'None
      Height          =   4335
      Left            =   120
      ScaleHeight     =   4335
      ScaleWidth      =   4335
      TabIndex        =   2
      Top             =   120
      Width           =   4335
   End
   Begin VB.CommandButton CancelButton 
      Caption         =   "Cancel"
      Height          =   375
      Left            =   4680
      TabIndex        =   1
      Top             =   600
      Width           =   1215
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "OK"
      Height          =   375
      Left            =   4680
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
End
Attribute VB_Name = "frmcolor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Private Declare Function FloodFill Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Sub CancelButton_Click()
    Unload Me
End Sub

Private Sub colortext_Change()
    Dim i As Long
    If colortext.Text < Hex(0) Then colortext.Text = "0"
    If colortext.Text > Hex(RGB(255, 255, 255)) Then colortext.Text = Trim(Hex(RGB(255, 255, 255)))
    Do While Len(colortext.Text) < 6
        colortext.Text = "0" & colortext.Text
    Loop
    If Len(colortext.Text) > 6 Then colortext.Text = "FFFFFF"
End Sub




Private Sub Form_Load()
    colorprint piccolor
    colorload frmmain.Labelshow.ForeColor
End Sub

Private Sub OKButton_Click()
    frmmain.Labelshow.ForeColor = rec
    Unload Me
End Sub

Sub colorprint(pic As PictureBox)
    Dim i As Long
    pic.AutoRedraw = True
    pic.Cls
    pic.Scale (-190, -110)-(190, 110)
    six pic, 0, 0, 5, RGB(255, 255, 255)
    For i = 1 To 5
        six pic, i * 17.32, 0, 5, RGB(255, 255 - i * 51, 255 - i * 51)
        six pic, -i * 17.32, 0, 5, RGB(255 - i * 51, 255, 255)
        six pic, i * 8.66, i * 8, 5, RGB(255, 255, 255 - i * 51)
        six pic, -i * 8.66, -i * 8, 5, RGB(255 - i * 51, 255 - i * 51, 255)
        six pic, i * 8.66, -i * 8, 5, RGB(255, 255 - i * 51, 255)
        six pic, -i * 8.66, i * 8, 5, RGB(255 - i * 51, 255, 255 - i * 51)
        sixline pic, i * 8.66, -i * 8, RGB(255, 255 - 51 * i, 255), i * -8.66, -i * 8, RGB(255 - 51 * i, 255 - 51 * i, 255), i - 1
        sixline pic, i * 8.66, i * 8, RGB(255, 255, 255 - 51 * i), i * -8.66, i * 8, RGB(255 - 51 * i, 255, 255 - 51 * i), i - 1
        sixline pic, i * 17.32, 0, RGB(255, 255 - 51 * i, 255 - 51 * i), i * 8.66, -i * 8, RGB(255, 255 - 51 * i, 255), i - 1
        sixline pic, -i * 17.32, 0, RGB(255 - 51 * i, 255, 255), -i * 8.66, i * 8, RGB(255 - 51 * i, 255, 255 - 51 * i), i - 1
        sixline pic, i * 17.32, 0, RGB(255, 255 - 51 * i, 255 - 51 * i), i * 8.66, i * 8, RGB(255, 255, 255 - 51 * i), i - 1
        sixline pic, -i * 17.32, 0, RGB(255 - 51 * i, 255, 255), -i * 8.66, -i * 8, RGB(255 - 51 * i, 255 - 51 * i, 255), i - 1
    Next i
    For i = 6 To 8
        six pic, i * 17.32, 0, 5, RGB(255 - (i - 5) * 51, 0, 0)
        six pic, -i * 17.32, 0, 5, RGB(0, 255 - (i - 5) * 51, 255 - (i - 5) * 51)
        six pic, i * 8.66, i * 8, 5, RGB(255 - (i - 5) * 51, 255 - (i - 5) * 51, 0)
        six pic, -i * 8.66, -i * 8, 5, RGB(0, 0, 255 - (i - 5) * 51)
        six pic, i * 8.66, -i * 8, 5, RGB(255 - (i - 5) * 51, 0, 255 - (i - 5) * 51)
        six pic, -i * 8.66, i * 8, 5, RGB(0, 255 - (i - 5) * 51, 0)
        sixline pic, i * 8.66, -i * 8, RGB(255 - 51 * (i - 5), 0, 255 - 51 * (i - 5)), i * -8.66, -i * 8, RGB(0, 0, 255 - 51 * (i - 5)), i - 1
        sixline pic, i * 8.66, i * 8, RGB(255 - 51 * (i - 5), 255 - 51 * (i - 5), 0), i * -8.66, i * 8, RGB(0, 255 - 51 * (i - 5), 0), i - 1
        sixline pic, -i * 17.32, 0, RGB(0, 255 - 51 * (i - 5), 255 - 51 * (i - 5)), -i * 8.66, i * 8, RGB(0, 255 - 51 * (i - 5), 0), i - 1
        sixline pic, i * 17.32, 0, RGB(255 - 51 * (i - 5), 0, 0), i * 8.66, -i * 8, RGB(255 - 51 * (i - 5), 0, 255 - 51 * (i - 5)), i - 1
        sixline pic, i * 17.32, 0, RGB(255 - 51 * (i - 5), 0, 0), i * 8.66, i * 8, RGB(255 - 51 * (i - 5), 255 - 51 * (i - 5), 0), i - 1
        sixline pic, -i * 17.32, 0, RGB(0, 255 - 51 * (i - 5), 255 - 51 * (i - 5)), -i * 8.66, -i * 8, RGB(0, 0, 255 - 51 * (i - 5)), i - 1
    Next i
End Sub

Sub six(obj As PictureBox, X As Long, Y As Long, i As Long, c As Long)
    obj.Line (X, Y + i)-(X - i * 1.732, Y + i * 0.5), c
    obj.Line (X - i * 1.732, Y + i * 0.5)-(X - i * 1.732, Y - i * 0.5), c
    obj.Line (X - i * 1.732, Y - i * 0.5)-(X, Y - i), c
    obj.Line (X, Y - i)-(X + i * 1.732, Y - i * 0.5), c
    obj.Line (X + i * 1.732, Y - i * 0.5)-(X + i * 1.732, Y + i * 0.5), c
    obj.Line (X + i * 1.732, Y + i * 0.5)-(X, Y + i), c
    Dim hb As Long, ohb As Long
    hb = CreateSolidBrush(c)
    ohb = SelectObject(obj.hdc, hb)
    FloodFill obj.hdc, ((obj.Width / 2) / 190 * X + obj.Width / 2) / 15, ((obj.Height / 2) / 110 * Y + obj.Height / 2) / 15, c
    SelectObject obj.hdc, ohb
    DeleteObject hb
    obj.Line (X, Y + i)-(X - i * 1.732, Y + i * 0.5), obj.BackColor
    obj.Line (X - i * 1.732, Y + i * 0.5)-(X - i * 1.732, Y - i * 0.5), obj.BackColor
    obj.Line (X - i * 1.732, Y - i * 0.5)-(X, Y - i), obj.BackColor
    obj.Line (X, Y - i)-(X + i * 1.732, Y - i * 0.5), obj.BackColor
    obj.Line (X + i * 1.732, Y - i * 0.5)-(X + i * 1.732, Y + i * 0.5), obj.BackColor
    obj.Line (X + i * 1.732, Y + i * 0.5)-(X, Y + i), obj.BackColor
End Sub
Sub sixline(obj As PictureBox, x1 As Long, y1 As Long, c1 As Long, x2 As Long, y2 As Long, c2 As Long, n As Long)
    Dim i As Long
    Dim r1 As Long, g1 As Long, b1 As Long
    Dim r2 As Long, g2 As Long, b2 As Long
    r1 = c1 Mod 256
    g1 = (c1 Mod 65536) \ 256
    b1 = c1 \ 65536
    r2 = c2 Mod 256
    g2 = (c2 Mod 65536) \ 256
    b2 = c2 \ 65536
    For i = 1 To n
        six obj, x1 + (x2 - x1) / (n + 1) * i, y1 + (y2 - y1) / (n + 1) * i, 5, RGB(r1 + (r2 - r1) / (n + 1) * i, g1 + (g2 - g1) / (n + 1) * i, b1 + (b2 - b1) / (n + 1) * i)
    Next i
End Sub

Private Function rec()
    rec = CDbl("&h" & colortext)
End Function

Private Sub piccolor_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If piccolor.Point(X, Y) <> piccolor.BackColor Then colortext = Trim(Hex(piccolor.Point(X, Y)))
End Sub

Private Sub colorload(c As Long)
    colortext.Text = Hex(c)
End Sub
